Open Data Soft предлагает данные по AirBNB. В датасете 85 переменных. Попробуем использовать этот датасет, чтобы увидеть, что влияет на цену аренду арендованных квартир.
Для исследования возьмем Берлин. Из базы выберем 2000 строк.
rm(list = ls())
library(jsonlite)
library(data.table)
library(ggplot2)
library(plotly)
#на портале Open Data Soft есть генератор ссылок для API.
ODS_API_Link <- "https://data.opendatasoft.com/api/records/1.0/search/?dataset=airbnb-listings%40public&rows=2000&facet=host_response_time&facet=host_response_rate&facet=host_verifications&facet=city&facet=country&facet=property_type&facet=room_type&facet=bed_type&facet=amenities&facet=availability_365&facet=cancellation_policy&facet=features&refine.city=Berlin"
raw_data <- fromJSON(ODS_API_Link)
# Датасет оказался списком. Данные обнаружим по индексу [["records"]][["fields"]]
Full_Data_Table <- as.data.table(raw_data[["records"]][["fields"]])
#Посмотрим, какие бывают переменные
Variables <-names(Full_Data_Table)
#Получим описательные статистики цен по районам Берлина
Price_Descr_stats <- Full_Data_Table[!(is.na(neighbourhood)&!is.na(price)),
.(.N,
max_price = max(price),
min_price = min(price),
avg_price = mean(price),
sd_price = sd(price)),
by = neighbourhood]
#Иногда из-за единственного наблюдения в группе, появляем NA. Присвоим им 0.
Price_Descr_stats[is.na(sd_price), sd_price := 0]
#Хотим увидеть, какие 10 районов чаще всего встречаются на AirBNB.
Top_10_Rent<-Price_Descr_stats[order(N, decreasing = T)][1:10]
# Посмотрим распределение частот сдаваемых квартир в каждом районе.
ggplot(Top_10_Rent, aes(x= neighbourhood, y = N, fill = neighbourhood )) +
geom_bar(stat = "identity")+
theme_classic()+
labs(title= "Распределение сдаваемых квартир по районам",
y="Число сдаваемых квартир", x = "Район")
# Посмотрим, есть ли разница по ценам квартир в зависимости от района.
ggplot(Top_10_Rent, aes(x= neighbourhood, fill = neighbourhood ) ) +
geom_boxplot(aes(
lower = avg_price - sd_price,
upper = avg_price + sd_price,
middle = avg_price,
ymin = avg_price - 3*sd_price,
ymax = avg_price + 3*sd_price),
stat = "identity") +
theme_bw()+
labs(title= "Зависимость цены квартиры от района",
y="Цена", x = "Район")
#Очевидно, мы увидим связь между площадью и стоимостью аренды. Однако мало кто указывает площадь. Данных очень мало для моделей, но мы покажем эту связь с помощью графика.
ggplot(Full_Data_Table, aes(x = square_feet, y = price)) +
geom_point(color = "blue")+
geom_smooth(color = "red") +
theme_classic()+
labs(title= "Зависимость цены квартиры от площади",
y="Цена", x = "Площадь квартиры")
# Посмотрим также, как менялось число арендодателей на airbnb с годами в Берлине.
# Отформатируем переменную host_since - когда человек зарегистрировался как арендодатель - оставим только год.
Full_Data_Table[, host_since_year:= format(as.Date(host_since), "%Y") ]
#сгруппируем переменную по годам
Grouped_by_year <- Full_Data_Table[order(host_since_year), .N , by = host_since_year]
# Для того, чтобы показывать рост (а не прирост), сделаем переменную кумулятивной.
Grouped_by_year[,Cumulative_hosts := cumsum(N) ]
#Построим график
plot_ly(data = Grouped_by_year, x = ~host_since_year, y = ~Cumulative_hosts, type = "bar") %>%
layout(yaxis = list('Количество арендодателей'), xaxis = list("Год"), title = list("Динамика арендодателей на AirBNB, Berlin") )
МЫ увидели распределение по частотам арендуемых квартир Берлина. Узнаем, что 5 районов забирают наибольшую долю арендуемых квартир.
В то же время, BoxPlot показал, что разницы в цене нет для различных районов из топ-10. Видим зависимость цены от площади квартиры. О характере связи говорить сложно. Линия графика была подобрана как нелинейная. В то же время линейная модель тоже могла бы быть уместна.
Есть несколько переменных, которые могут влиять на цены квартир. Однако для их получения нужны некоторые манипуляции
# Возможно, цена квартиры зависит от расстояния до центра.
# Чтобы измерить его - возьмем координаты условного центра Берлина - Берлинский собор.
# Измерим евклидово расстояние от координат квартир до Берлинского собора.
# Координаты Берлинского собора:
# Longitude of Berliner Dom: 13.401078
# Latitude of Berliner Dom: 52.519061
BD_Long <- 13.401078
BD_Lat <- 52.519061
# Считаем разницу по ширине и долготе между квартирами и Собором.
Full_Data_Table[,Long_from_center:= BD_Lat - as.numeric(latitude) ]
Full_Data_Table[,Lat_from_center:= BD_Long - as.numeric(longitude)]
#считаем расстояние по Пифагору
Full_Data_Table[, Distance_from_center := sqrt(Long_from_center^2 + Lat_from_center^2) ]
#Посмотрим, видна ли зависимость между ценой и расстоянием от центра
ggplot(Full_Data_Table, aes(x = Distance_from_center, y =price ))+
geom_point(color = "red" ) +theme_bw()
# Арендаторы квартир перечисляют доступные удобства. Также в датасете доступны данные по качеству профиля - верификаций, фото и проч (features).
# Эти переменные перечисляются через запятую. Разделим их и пересчитаем. Новые переменные получат суффикс _count.
cols_to_count <-c("amenities", "features")
Full_Data_Table[ , paste0(cols_to_count,"_count") :=
lapply(.SD, function(x) sapply(strsplit(x,","), length)),
.SDcols = cols_to_count]
Создали несколько новых переменных - 1) операционализировали рассчитали расстояние от центра (расстояние от квартиры до Берлинского Собора), 2) посчитали количество удобств в квартире в качестве отдельной переменной,
3) Для оценки качества странички арендодателя посчитали атрибуты, которые присутствуют на его страницы
Какие переменные могут предсказывать стоимость сдаваемой квартиры, с моей точки зрения? а) Количество удобств (amenities_count) - чем больше удобств, тем дороже должна стоить квартира.
б) Количество кроватей (beds) - ожидаем положительную связь. Чем больше кроватей, чем больше должна стоить квартира.
в) Стоимость уборки (cleaning_fee) - влияние переменной неоднозначно. С одной стороны,дополнительные расходы за уборку должны побуждать арендодателя сбрасывать цены, чтобы оставаться конкурентным (негативная связь). С другой стороны, ценность квартиры и чистоты в ней может одновременно заставлять повышать стоимость как за аренду, так и за уборку (позитивная связь).
г) Залог за сохранность (security deposit) - влияние неоднозначно (по той же причине, что в пунтке в.)
д) Количество гостей (guests_included) - чем больше гостей, тем больше должна стоить квартира.
ж) Расстояние от центра (Distance_from_center) - ожидаем отрицательную связь. Чем дальше от центра квартира, тем дешевле должна стоить.
# Выберем список переменных, которые будем изучать.
vars_to_check <- c("price", "amenities_count", "beds", "cleaning_fee", "security_deposit", "guests_included", "extra_people", "Distance_from_center")
# Заменим NA в переменных, которые их содержат, на среднее
Full_Data_Table[ ,
c("security_deposit", "cleaning_fee") :=
lapply(.SD, function(x) replace(x, is.na(x), mean(x, na.rm = T))) ,
.SDcols = c("security_deposit", "cleaning_fee")]
# Проведем иерархический кластерный анализ
cluster_fit<-hclust(dist(Full_Data_Table[, vars_to_check, with =F], method = "euclidean") ,
method = "ward.D" )
plot(cluster_fit)
summary(cluster_fit)
## Length Class Mode
## merge 3998 -none- numeric
## height 1999 -none- numeric
## order 2000 -none- numeric
## labels 0 -none- NULL
## method 1 -none- character
## call 3 -none- call
## dist.method 1 -none- character
# Судя по графику, наиболее содержательно выделять три фактора
clusters<-cutree(cluster_fit, k =3)
# Добавим к массиву данных полученные номера кластеров.
Full_Data_Table <- cbind(Full_Data_Table,clusters)
# Посчитаем средние значеения в кластерах
Cluster_Means <- Full_Data_Table[, lapply(.SD, function(x) mean(x, na.rm =T) ) ,by = clusters,.SDcols = vars_to_check]
Cluster_Means
## clusters price amenities_count beds cleaning_fee
## 1: 1 56.80141 11.80269 1.635897 27.11323
## 2: 2 74.72523 13.12613 1.801802 36.40569
## 3: 3 46.79263 11.83871 1.387097 23.90792
## security_deposit guests_included extra_people Distance_from_center
## 1: 225.28701 1.327995 7.693145 0.05239577
## 2: 421.41892 1.563063 9.157658 0.04936649
## 3: 95.28571 1.304147 9.336406 0.05393369
# Также посмотрим на наполняемость кластеров
Cluster_Numbers <- Full_Data_Table[, .N ,by = clusters]
Cluster_Numbers
## clusters N
## 1: 1 1561
## 2: 2 222
## 3: 3 217
Для проведения кластерного анализа выбрали переменные, которые могли бы влиять на стоимость аренды квартиры.
Среди них - количество удобств в квартире, расстояние от центра, количество кроватей, цена уборки, залог за сохранность, количество включенных гостей и число дополнительных гостей.
Проведен кластерный анализ. В рамках кластерного анализа выделили три фактора.
Наиболее часто встречающийся фактор - средние квартиры, требущие среднего (относительно других) залога за сохранность и оплаты уборки.
Менее распространены крайние кластеры - 1) Дорогие квартиры с дорогой уборкой с большим залогом 2) Дешевые квартиры с дешевой уборкой и малым залогом.
Таким образом, видим основное различие в ценовых параметрах квартир
library(randomForest)
library(rpart)
library(rpart.plot)
library(MLmetrics)
# Переведем цену в бинарный фактор. Две группы - выше и ниже среднего.
Full_Data_Table[, price_binary := ifelse(price<mean(price, na.rm= T), 0,1 )]
Full_Data_Table[, price_binary:= as.factor(price_binary)]
# Создадим выборку-учителя и выборку для теста.
test_rows <- sample(2000, Full_Data_Table[, .N]*0.3 )
Train <- Full_Data_Table[!test_rows]
Test <- Full_Data_Table[test_rows]
# Вспомним наши исследуемые переменные.
vars_to_check <- c("price_binary", "amenities_count", "beds", "cleaning_fee", "security_deposit", "guests_included", "extra_people", "Distance_from_center" )
# Создадим дерево решений и нарисуем его.
tree_fit <- rpart(price_binary ~ ., Train[, vars_to_check, with = F])
rpart.plot(tree_fit, type =4 )
# Переменная beds - содержит NA - заменим эти значения на средние
Train[, beds := ifelse(is.na(beds), mean(beds, na.rm = T), beds)]
# Таким образом я хотел бы динамически менять все переменные с NA на среднее переменных.
# Но Accuracy почему-то выходит в 0.
#Train <- Train[, lapply(.SD, function(x) ifelse(is.na(x), mean(x, na.rm = T), x )), .SDcols = vars_to_check]
# Создадим модель случайных лесов.
Forest_Fit <- randomForest(price_binary ~ ., Train[, vars_to_check, with = F])
summary(Forest_Fit)
## Length Class Mode
## call 3 -none- call
## type 1 -none- character
## predicted 1400 factor numeric
## err.rate 1500 -none- numeric
## confusion 6 -none- numeric
## votes 2800 matrix numeric
## oob.times 1400 -none- numeric
## classes 2 -none- character
## importance 7 -none- numeric
## importanceSD 0 -none- NULL
## localImportance 0 -none- NULL
## proximity 0 -none- NULL
## ntree 1 -none- numeric
## mtry 1 -none- numeric
## forest 14 -none- list
## y 1400 factor numeric
## test 0 -none- NULL
## inbag 0 -none- NULL
## terms 3 terms call
# Точность модели - около 60%. О качестве модели говорить сложно. Хотя мы достигли "среднего" уровня точности, такой результат по сути вряд ли может быть полезным. Вместо нашей модели можно использовать подбрасывания монетки.
Accuracy(Forest_Fit$predicted, Test[, price_binary])
## [1] 0.5828571
Переменную цены преобразовали в бинарную - значения выше среднего обозначают единицу, ниже среднего - ноль.
Исходя из дерева видим, что наибольшая вероятность арендуемой квартиры примкнуть к более дорогой половине - при большем количестве кроватей и при большей плате за уборку. Тем не менее, модель показывает точность около 0,6. Это говорит о том, что модель способна правильно предсказывать половину случаев принадлежности сдаваемой квартиры. Однако поэтому модель оказывается по сути бесполезной.
# Построим модель логистической регресси.
Log_Fit <- glm(price_binary ~.,family=binomial(link='logit'),data=Train[, vars_to_check, with = F])
# Сделаем прогноз на тестовой выборке
fitted.results <- predict(Log_Fit,Test,type='response')
summary(Log_Fit)
##
## Call:
## glm(formula = price_binary ~ ., family = binomial(link = "logit"),
## data = Train[, vars_to_check, with = F])
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.4361 -0.7736 -0.5367 0.7813 2.4578
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -4.9093103 0.3573518 -13.738 < 2e-16 ***
## amenities_count 0.0518797 0.0151832 3.417 0.000633 ***
## beds 0.4430550 0.0750076 5.907 3.49e-09 ***
## cleaning_fee 0.0678087 0.0070356 9.638 < 2e-16 ***
## security_deposit 0.0019135 0.0007949 2.407 0.016079 *
## guests_included 0.8003638 0.1333617 6.001 1.96e-09 ***
## extra_people -0.0013623 0.0075924 -0.179 0.857599
## Distance_from_center -7.6502065 2.2002339 -3.477 0.000507 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1835.2 on 1399 degrees of freedom
## Residual deviance: 1406.7 on 1392 degrees of freedom
## AIC: 1422.7
##
## Number of Fisher Scoring iterations: 5
# Проверим качество модели. Когда вероятность больше 0.5 - будем считать наблюдение 1 (цена выше среднего). Когда меньше 0.5 - считаем, что цена ниже среднего.
fitted.results[fitted.results > 0.5] <- 1
fitted.results[fitted.results < 0.5] <- 0
# С помощью корреляции посмотрим, насколько хорошо модели предсказывает значения.
cor.test(as.numeric(Test$price_binary), as.numeric(fitted.results ))
##
## Pearson's product-moment correlation
##
## data: as.numeric(Test$price_binary) and as.numeric(fitted.results)
## t = 13.9, df = 597, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.4314581 0.5526950
## sample estimates:
## cor
## 0.4944779
Логистическая регрессия показала значимость всех факторов, кроме переменных “дополнительных гостей” и “залога за сохранность”. Остальные переменные показали 99% значимость.
Проверили качество модели на тестовой выборке. Для этого проверили корреляции предсказаний переменной и реальные значения на тестовой выборке. Обнаружили корреляцию в районе 0.5. Предсказания совпадают с реальностью в половине случаев. Справедливо как и в модели деревьев решений поднять вопрос о полезности этой модели.
# Проведем линейную регрессию.
# Уберем из списка переменных бинарную переменную цены, добавив переменную цены без выбросов.
#Убираем бинарную переменную.
vars_to_check <- vars_to_check[-which(vars_to_check =="price_binary")]
# В показателе цены много выбросов. Они могут помешать регрессионной модели. Избавимся от них
# Выбросы могут быть только в сторону повышения. (поэтому левый край не смотрим) (mean(price) - 2*sd...)
Train[price < (mean(price) + 2*sd(price, na.rm =T)), Price_no_outliers:= price]
Train[price > (mean(price) + 2*sd(price, na.rm =T)), Price_outliers:= price]
vars_to_check <- c("Price_no_outliers", vars_to_check )
#Строим линейную модель
Lin_Fit <- lm(Price_no_outliers~., data=Train[, vars_to_check, with = F])
confint(Lin_Fit)
## 2.5 % 97.5 %
## (Intercept) 2.50901547 13.6406487
## amenities_count 0.41211232 0.9754854
## beds 2.73262203 5.4418938
## cleaning_fee 0.53395333 0.7455681
## security_deposit 0.01122447 0.0399725
## guests_included 6.35116534 10.2002658
## extra_people -0.09297817 0.1928533
## Distance_from_center -134.78045877 -59.4877120
summary(Lin_Fit)
##
## Call:
## lm(formula = Price_no_outliers ~ ., data = Train[, vars_to_check,
## with = F])
##
## Residuals:
## Min 1Q Median 3Q Max
## -72.354 -15.360 -3.349 12.414 108.166
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.074832 2.837180 2.846 0.004494 **
## amenities_count 0.693799 0.143590 4.832 1.51e-06 ***
## beds 4.087258 0.690527 5.919 4.11e-09 ***
## cleaning_fee 0.639761 0.053935 11.862 < 2e-16 ***
## security_deposit 0.025598 0.007327 3.494 0.000492 ***
## guests_included 8.275716 0.981041 8.436 < 2e-16 ***
## extra_people 0.049938 0.072851 0.685 0.493166
## Distance_from_center -97.134085 19.190272 -5.062 4.74e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 22.7 on 1335 degrees of freedom
## (57 observations deleted due to missingness)
## Multiple R-squared: 0.2923, Adjusted R-squared: 0.2886
## F-statistic: 78.77 on 7 and 1335 DF, p-value: < 2.2e-16
Согласно линейной модели, все коэффициенты значимы. Большинство из них даже на 99% уровне значимости. Однако влияние этих переменных достаточно мало.
Наиболее сильное влияние оказывает переменная расстояния от центра. Однако измерить его конкретное влияние затруднительно, поскольку величина обозначает географические координаты (а не метры).
По значимости эта переменная сильно опережает другие. Другие переменные вносят менее значительный вклад (19.78530 - std. Error). Среди них наиболее значимая переменная - количество гостей (0.85431).
Расстояние от центра негативно связано с ценой - чем больше расстояние от центра, тем ниже цена. Остальные переменные связаны с ценой положительно.
В то же время, модель объясняет достаточно мало наблюдений R^2 - около 30%.
В Берлине стоимость аренды квартиры не зависит от района, в котором она находится.
Однако есть проявляющаяся не во всех случаях зависимость цены квартиры от расстояния до центра.
Также на основе моделей можно говорить о значимости влияния таких переменных как количество удобств, количество кроватей, количество гостей и стоимость уборки. Остается под сомнением вклад таких переменных, как залог или дополнительные гости.